home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1993 July / InfoMagic USENET CD-ROM July 1993.ISO / sources / misc / volume30 / mserv-3.0 / part02 < prev    next >
Encoding:
Text File  |  1992-06-19  |  54.5 KB  |  1,807 lines

  1. Newsgroups: comp.sources.misc
  2. From: jv@mh.nl (Johan Vromans)
  3. Subject:  v30i047:  mserv-3.0 - Squirrel Mail Server Software, Part02/04
  4. Message-ID: <1992Jun14.005847.18781@sparky.imd.sterling.com>
  5. X-Md4-Signature: 1d68190bfa47a089722768cc576488ce
  6. Date: Sun, 14 Jun 1992 00:58:47 GMT
  7. Approved: kent@sparky.imd.sterling.com
  8.  
  9. Submitted-by: jv@mh.nl (Johan Vromans)
  10. Posting-number: Volume 30, Issue 47
  11. Archive-name: mserv-3.0/part02
  12. Environment: Perl
  13.  
  14. #! /bin/sh
  15. # This is a shell archive.  Remove anything before this line, then feed it
  16. # into a shell via "sh file" or similar.  To overwrite existing files,
  17. # type "sh file -c".
  18. # The tool that generated this appeared in the comp.sources.unix newsgroup;
  19. # send mail to comp-sources-unix@uunet.uu.net if you want that tool.
  20. # Contents:  INSTALL chkconfig.pl dorequest.pl dr_mail.pl
  21. #   mserv_config.pl unpack.pl
  22. # Wrapped by kent@sparky on Sat Jun 13 19:46:22 1992
  23. PATH=/bin:/usr/bin:/usr/ucb ; export PATH
  24. echo If this archive is complete, you will see the following message:
  25. echo '          "shar: End of archive 2 (of 4)."'
  26. if test -f 'INSTALL' -a "${1}" != "-c" ; then 
  27.   echo shar: Will not clobber existing file \"'INSTALL'\"
  28. else
  29.   echo shar: Extracting \"'INSTALL'\" \(12682 characters\)
  30.   sed "s/^X//" >'INSTALL' <<'END_OF_FILE'
  31. X@(#)@ INSTALL    3.14 - INSTALL
  32. X
  33. XInstallation
  34. X============
  35. X
  36. X 1. Preparation
  37. X
  38. X    As distributed, perl is expected to reside in /usr/local/bin.  You
  39. X    can change this in the Makefile if your perl resides somewhere
  40. X    else.
  41. X
  42. X    The mail server needs a user id to own the programs, and a place
  43. X    where the programs and files can be stored.
  44. X    Pre-configured values are "mserv" and "/usr/local/lib/mserv"
  45. X    respectively. We'll call the library LIBDIR in this document.
  46. X    LIBDIR could be the HOME directory of the mail server owner, but it
  47. X    need not.
  48. X    If you prefer a different value for LIBDIR, change the appropriate
  49. X    line in the Makefile.
  50. X    The name of the mail server owner can be changed in step 2, as
  51. X    described below.
  52. X
  53. X    Since all messages sent by the mail server are sent under the
  54. X    server owner uid, its full name (the GCOS or comment field in
  55. X    /etc/passwd) should be descriptive.
  56. X
  57. X    The mail server owner does not need any privileges, except for
  58. X    read access to the archives, and read/write access to LIBDIR.
  59. X
  60. X    Do not use the root account for server owner!
  61. X
  62. X 2. Configure and build
  63. X
  64. X    Tailor "mserv_config.pl" to reflect your specific needs. It has
  65. X    extensive descriptions for configuration variables and values.
  66. X    Do not forget to tailor the Makefile also, if needed.
  67. X
  68. X    It may be a good habit to generate differences using the 'diff'
  69. X    program so you can apply your modifications to a new version of
  70. X    the mail server software easily.
  71. X
  72. X    Issue "make" to prepare the programs. 
  73. X
  74. X    If you select the index file feature, you need GNU find / locate.
  75. X    As of GNU find version 3.6, you can use the locate program 'as is'.
  76. X    For version 3.5, change GNUFIND in the Makefile to designate where
  77. X    your GNU find sourcetree is, and issue "make ixlookup".
  78. X    This will build a customized version of GNU locate, called
  79. X    "ixlookup".
  80. X
  81. X    Issue "make listener" to generate and compile the listener
  82. X    program. This command uses mserv_config.pl (from the current
  83. X    directory) to determine how to build the listener program.
  84. X
  85. X 3. Installation
  86. X
  87. X    Now "su mserv" and execute "make install".
  88. X
  89. X    This will install all programs and files in LIBDIR.
  90. X    It will not install programs ixlookup and listener, since they
  91. X    need special treatment.
  92. X
  93. X    If you select the index file feature, issue "make install-ixlookup"
  94. X    if you need the customized version of GNU locate 3.5. 
  95. X    Note that whoever creates the index files, must have write access
  96. X    to the location the index files are stored.
  97. X
  98. X    If you configured the listener to use the setruid/setrgid system
  99. X    calls, you need to "su mserv" before executing "make
  100. X    install-listener".
  101. X
  102. X    If you do not have setruid/setrgid, the program must be installed
  103. X    setuid root.  In this case, you have to "su root" before doing
  104. X    "make install-listener".  Look at the source of the listener.c
  105. X    program to verify it will not harm your system security.
  106. X
  107. X 4. Adding aliases
  108. X
  109. X    Create a suitable alias in /usr/lib/aliases (or wherever your
  110. X    aliases are kept):
  111. X
  112. X      mail-server : "|LIBDIR/listener"
  113. X
  114. X    To get rid of bounced mail, the mail server fakes "bit-bucket" as
  115. X    its return address. To avoid bounced mails filling your
  116. X    filesystems, add another alias:
  117. X
  118. X      bit-bucket: /dev/null
  119. X
  120. X 5. Verification of the installation
  121. X
  122. X    All the following steps should be executed under the mail server
  123. X    owner!
  124. X
  125. X    * Run program LIBDIR/chkconfig. It shows most of the
  126. X      configuration values, and verifies the existence of files and
  127. X      programs.
  128. X
  129. X      You may need to run the perl tool "h2ph" to supply system
  130. X      include files needed for locking.
  131. X
  132. X    * Verify your locking strategy. Execute
  133. X     
  134. X        % perl -s testlock.pl -test1 &
  135. X     
  136. X      It should say "Got the lock -- waiting ...".
  137. X      Now execute
  138. X     
  139. X        % perl -s testlock.pl -test2 &
  140. X     
  141. X      It should say "Good. Could not lock -- waiting ...".
  142. X      Now kill the first process. The second process should print "ret = 1" 
  143. X      and exit.
  144. X
  145. X    * Verify the working of the "dorequest" program:
  146. X
  147. X        % LIBDIR/dorequest <youraddress> <arealfile>
  148. X
  149. X      You should receive mail(s) containing the indicated file.
  150. X      NOTE: If your site is running sendmail, the mail(s) are queued
  151. X      for delivery. They can take some time before they arrive,
  152. X      depoending on how often the sendmail queue is run.
  153. X      You may want to inspect the sendmail queue to see if your
  154. X      mail(s) are in it.
  155. X
  156. X      If no mail(s) arrive, try
  157. X
  158. X        % LIBDIR/dorequest -debug <youraddress> <arealfile>
  159. X
  160. X      and see what happens.
  161. X
  162. X    * Execute the "process" script by hand:
  163. X
  164. X        % LIBDIR/process
  165. X        From bla
  166. X        From: <youraddress>
  167. X
  168. X        test
  169. X        send HELP
  170. X        end
  171. X
  172. X      (The program should terminate after processing the "end"
  173. X      command). 
  174. X      Now you should receive a mail (from yourself!) telling that your
  175. X      request has been processed.
  176. X      NOTE: If your site is running sendmail, and sendmail is
  177. X      configured to use 'queued' delivery, the mail(s) are not
  178. X      delivered immediately.
  179. X      You may want to inspect the sendmail queue to see if your
  180. X      mail is in it, or run the queue by hand.
  181. X
  182. X      In case of trouble: run LIBDIR/process with "-debug" to find out
  183. X      what happens.
  184. X
  185. X    * Execute the "process" script again with the same input, but
  186. X      leave out the line "test".
  187. X
  188. X      Again you should receive a mail (from yourself!) telling that your
  189. X      request has been processed. It should also tell you that your
  190. X      request has been queued.
  191. X
  192. X      If you configured $auto_runrequest, program "dorequest" will be
  193. X      run to handle your request. You should receive a mail with the
  194. X      requested file.
  195. X
  196. X      In case of trouble: run LIBDIR/process with "-debug" to find out
  197. X      what happens. This will prevent "dorequest" from being invoked,
  198. X      so you can study the contents of LIBDIR/queue.
  199. X
  200. X    * Execute the "listener" program with the same input.
  201. X
  202. X      Again you should receive a mail message.
  203. X
  204. X      If you configured $auto_runrequest, program "dorequest" will be
  205. X      run to handle your request. You should receive a mail with the
  206. X      requested file.
  207. X
  208. X    * As another user, run the "listener" program with the same input.
  209. X
  210. X      Again you should receive a mail, still originating from the
  211. X      mail server owner.
  212. X
  213. X    * Still going strong? Now, as another user, send a mail message to
  214. X      your mail server:
  215. X
  216. X      % mail mail-server
  217. X      send foo bar INDEX
  218. X      end
  219. X      ^D
  220. X
  221. X      (Mail programs usually do not terminate after reading the "end"
  222. X      line. Issue Control-D or whatever you local EndOfFile setting is). 
  223. X      
  224. X      You will receive a return mail, indicating which archive entries
  225. X      were found, and how they would be transmitted.
  226. X
  227. X    * If you did not configure $auto_runrequest, change back to the
  228. X      mail server user, and inspect LIBDIR/queue to see that your
  229. X      request is in it.
  230. X      Run LIBDIR/dorequest without arguments; the selected file should
  231. X      be sent to you by email.
  232. X
  233. X    If you receive the requests, your mail server is fully
  234. X    operational! 
  235. X
  236. X 6. If you don't want to keep of log of transactions, remove the file
  237. X    "LIBDIR/logfile" that was created by the Makefile.
  238. X
  239. X 7. As a service: place the files "HELP" and "unpack.pl" in one of
  240. X    your archives. The Makefile prepares PUBDIR (defaults to
  241. X    LIBDIR/pub) for this purpose.
  242. X
  243. X    Also, supply shar-files with the btoa/atob handling
  244. X    programs, uudecode/uuencode, and compress/uncompress.
  245. X
  246. X    The contents of file LIBDIR/mserv.notes is prepended to every
  247. X    reply the mail server sends. This file can be used to supply a
  248. X    daily message about the server, new entries, etc.
  249. X
  250. X    The contents of file LIBDIR/mserv.hints is appended to every reply
  251. X    the mail server sends.
  252. X
  253. X    Make sure your archives have a decent copy of Dumas uud/uue and
  254. X    xxencode/xxdecode if you intent to support these.
  255. X    Likewise, zoo, zip, etc.
  256. X
  257. X    Also, provide a file "INDEX" that more or less describes what is
  258. X    in your archives. People are going to ask for it.
  259. X
  260. X    Since people usually don't read the documentation, link "help" to
  261. X    "HELP", "index" to "INDEX", "atob.shar" to "btoa.shar", etc.
  262. X
  263. X 8. Install crontab entries for the mail server processes. A sample
  264. X    crontab is included in the distribution as CRONTAB.sample.
  265. X
  266. X    30 0,2,4,6,18,20,22 * * * LIBDIR/do_runq
  267. X    0 3 * * * LIBDIR/makeindex
  268. X    0 7 * * * LIBDIR/do_report -errors -since .errrun
  269. X    10 7 * * 7 LIBDIR/do_report -full -collect
  270. X
  271. X    The above example runs the mail server queue every two hours,
  272. X    except during working hours. Once a day any mail server errors are
  273. X    reported, once a week the logfile data is accumulated and a usage
  274. X    report is generated.
  275. X
  276. X    CHECK AND MODIFY THESE SCRIPTS SINCE THEY WILL PROBABLY NOT
  277. X    DO WHAT YOU WANT!
  278. X
  279. X    Every night a three o'clock new index files are generated. You may
  280. X    leave this line out if you do not use index files.
  281. X
  282. X    If you configured auto_runrequest in mserv_common.pl, there is no
  283. X    need to run the queue that often; once or twice a day will be
  284. X    sufficient.
  285. X
  286. XInteraction of programs
  287. X=======================
  288. X
  289. XAn email message directed to the mail server will be passed to program
  290. X`listener'. This program disguises itself as the mail server owner and
  291. Xexecutes `process'.
  292. X
  293. X`process' parses the mail message, and extracts commands. Requests are
  294. Xlooked up, and --if viable-- written to the mail server queue.
  295. X
  296. XSome other time, `dorequest' will be run, either automatically from
  297. X`process' or via cron. This program will lock the queue and read all
  298. Xentries from it. It will also read any pending entries in queue~. Then
  299. Xit will empty the queue and release it.  Next, it will handle all
  300. Xentries it has read. Before handling a request, all in-core entries
  301. Xare written to file queue~ just in case the system goes down.
  302. XUpon completion of a request, a logfile entry is written and the
  303. Xrequest is removed from memory. Upon sucessful completion of
  304. X`dorequest' the file queue~ will be removed.
  305. X
  306. XEach queue entry takes one record from the queue file, with space
  307. Xseparated files as follows:
  308. X
  309. X  type        M for email, U for UUCP transfer, MP for packed email,
  310. X        UP for packed UUCP.
  311. X  recipient    the reply address used
  312. X  destination    (type M* only): email address
  313. X  host!path    (type U* only) UUCP host and path
  314. X  notify    (type U* only) UUCP notification user
  315. X  request    the request
  316. X  file        the name of the file
  317. X  encoding    (type M* only) encoding (B = btoa, U = uuencode, X = xxencode,
  318. X            D = Dumas' uue)
  319. X  limit        max size (in Kb) per chunk
  320. X  parts        comma-separated parts list.
  321. X
  322. XLogging
  323. X=======
  324. X
  325. XIf you select logging, all transfers that are sent are logged in the
  326. Xlogfile. Each record has a number of (space separated) fields as
  327. Xfollows:
  328. X
  329. X  date        e.g. 920501
  330. X  time        e.g. 15:22
  331. X  type        M for email, U for UUCP transfer
  332. X  destination    email address, or host!notify for UUCP transfers
  333. X  request    the name of the requested file
  334. X  Xnn/mm    X = encoding (B = btoa, U = uuencode, X = xxencode,
  335. X            D = Dumas' uue)
  336. X            Note: no encoding is specfied for UUCP transfers.
  337. X          nn/mm = part nn of mm parts
  338. X  size        the size of the transfer
  339. X
  340. XThe programs report.pl and do_report.pl can be used to generate
  341. Xreports from the logfile.
  342. X
  343. XErrors are logged with type `F'. The remainder of the record contains
  344. Xthe error message. 
  345. XIf an error is detected due to a user request, the queue entry for
  346. Xthis request is entered in the logfile with type `Q'.
  347. XIf the failure is temporary, the queue entry can be extracted from the
  348. Xlogfile and added to the queue (or better: queue~) file.
  349. X
  350. Xdo_report.pl can also be used to cleanup the logfile.
  351. X
  352. XDesign and Maintenance of the Archives
  353. X======================================
  354. X
  355. XThe mail server software can handle multiple archive directories.
  356. XEvery directory specified in @libdirs is treated equal.
  357. X
  358. XPlease consider the following points:
  359. X
  360. X - Hidden files (filenames starting with `.') and files that are not
  361. X   readable to `mserv' cannot be retrieved. They might show in the
  362. X   index, however.
  363. X
  364. X - If a file occurs multiple (e.g. "INDEX" in more than one archive
  365. X   directory) the first occurrence is retrieved.
  366. X
  367. X - If a directory occurs multiple it can not be retrieved.
  368. X
  369. X - For best results: name archives similar to "foo-XXX.tar.Z", where
  370. X   XXX is a version number, e.g. emacs-18.58.tar.Z or xdvi-12.zoo.
  371. X   This will aid people in finding the right version for a specific
  372. X   archive entry.
  373. X
  374. XPlease share your experiences and programs.
  375. X
  376. XGood Luck!
  377. X
  378. X    Johan Vromans
  379. X    Multihouse Research
  380. X    Doesburgweg 7
  381. X    2803 PL  Gouda
  382. X    The Netherlands
  383. X    Phone: +31 1820 62911
  384. X    E-mail: jv@mh.nl
  385. END_OF_FILE
  386.   if test 12682 -ne `wc -c <'INSTALL'`; then
  387.     echo shar: \"'INSTALL'\" unpacked with wrong size!
  388.   fi
  389.   # end of 'INSTALL'
  390. fi
  391. if test -f 'chkconfig.pl' -a "${1}" != "-c" ; then 
  392.   echo shar: Will not clobber existing file \"'chkconfig.pl'\"
  393. else
  394.   echo shar: Extracting \"'chkconfig.pl'\" \(8630 characters\)
  395.   sed "s/^X//" >'chkconfig.pl' <<'END_OF_FILE'
  396. X#!/usr/local/bin/perl
  397. X# chkconfig.pl -- check mserv configuration
  398. X# SCCS Status     : @(#)@ chkconfig    1.11
  399. X# Author          : Johan Vromans
  400. X# Created On      : Mon Apr 27 21:47:41 1992
  401. X# Last Modified By: Johan Vromans
  402. X# Last Modified On: Sat Jun  6 21:27:19 1992
  403. X# Update Count    : 94
  404. X# Status          : Development
  405. X
  406. X# DISCLAIMER: This prograim aids in finding configuration values
  407. X# and potential problems. No guarantees, however.
  408. X
  409. X$my_name = "chkconfig";
  410. X$my_version = "1.11";
  411. X#
  412. X################ Common stuff ################
  413. X
  414. X$libdir = $ENV{"MSERVLIB"} || "/usr/local/lib/mserv";
  415. Xunshift (@INC, $libdir);
  416. Xrequire "mserv_common.pl";
  417. X
  418. X################ Options handling ################
  419. X
  420. X&options if @ARGV > 0 && $ARGV[0] =~ /^-+[^-]+/;
  421. X@ARGV = ("-") unless @ARGV > 0;
  422. Xprint ($my_package, " [", $my_name, " ", $my_version, "]\n");
  423. X
  424. X################ Main ################
  425. X
  426. Xprint ("MSERVLIB = ", $ENV{"MSERVLIB"} || "(not set)", "\n");
  427. Xprint ("Program library: ", $libdir, " ", &fstat($libdir,1,1), "\n");
  428. Xprint ("\n");
  429. X
  430. Xif ( defined $mserv_owner && $mserv_owner ) {
  431. X    if ( @u = getpwnam ($mserv_owner) ) {
  432. X    print ("Server owner: ", $mserv_owner, ", uid = $u[2], gid = $u[3]",
  433. X           ", \"", $u[6], "\"\n");
  434. X    }
  435. X    else {
  436. X    print ("Server owner: ", $mserv_owner, " *** Unknown ***\n");
  437. X    }
  438. X}
  439. Xelse {
  440. X    die ("\$mserv_owner is not defined!\n");
  441. X}
  442. Xif ( defined $mserv_bcc && $mserv_bcc ) {
  443. X    if ( @u = getpwnam ($mserv_bcc) ) {
  444. X    print ("Bcc user: ", $mserv_bcc, ", uid = $u[2], gid = $u[3]",
  445. X           ", \"", $u[6], "\"\n");
  446. X    }
  447. X    else {
  448. X    print ("Bcc user: ", $mserv_bcc, " *** Unknown ***\n");
  449. X    }
  450. X}
  451. Xprint ("\n");
  452. X
  453. Xif ( $have_setruid ) {
  454. X    print ("The 'listener' program will use the setruid system call\n");
  455. X    print ("  It will change identity to compiled-in uid $u[2]\n")
  456. X    if $use_uid;
  457. X    print ("  (setenv will be used to set USER, LOGNAME and HOME)\n")
  458. X    if $have_setenv;
  459. X    if ( -x "$libdir/listener" ) {
  460. X    @st = stat (_);
  461. X    unless ( $st[4] == $u[2] && $st[2] & 0004000 == 0004000 ) {
  462. X        print ("The 'listener' program is not installed correctly!\n",
  463. X           "  It should be installed setuid $mserv_owner\n");
  464. X    }
  465. X    }
  466. X    else {
  467. X    print ("The 'listener' program is not yet installed.\n",
  468. X           "  Do not forget to install it setuid $mserv_owner\n");
  469. X    }
  470. X}
  471. Xelse {
  472. X    print ("The 'listener' program will use 'su' to change identity\n");
  473. X    if ( -x "$libdir/listener" ) {
  474. X    @st = stat (_);
  475. X    unless ( $st[4] == 0 && $st[2] & 0004000 == 0004000 ) {
  476. X        print ("The 'listener' program is not installed correctly!\n",
  477. X           "  It should be installed setuid root\n");
  478. X    }
  479. X    }
  480. X    else {
  481. X    print ("The 'listener' program is not yet installed\n",
  482. X           "  Do not forget to install it setuid root\n");
  483. X    }
  484. X}
  485. Xprint "\n";
  486. X
  487. X$f = $sendmail;
  488. X$f = $` if $f =~ / /;
  489. Xprint ("Replies will be sent using \"$sendmail\" ", &fstat($f,0,1), "\n");
  490. Xprint ("Preset mail headers:\n");
  491. Xprint (defined $sender ? "  $sender\n" : "  *** sender not defined ***\n");
  492. Xprint ("  ", join ("\n  ", @x_headers), "\n") if defined @x_headers;
  493. Xprint ("\n");
  494. X
  495. Xprint ("Transfer strategies:\n");
  496. Xif ( defined $chunkmail ) {
  497. X    $f = $chunkmail;
  498. X    $f = $` if $f =~ / /;
  499. X    print ("  email: \"$chunkmail\" ", &fstat($f,0,1), "\n");
  500. X    print ("         wait ", $mailer_delay, " seconds between chunks\n")
  501. X    if defined $mailer_delay;
  502. X    print ("         limits: ", $email_limits[1], "K (default), ",
  503. X       $email_limits[0], "K (min), ", $email_limits[2], "K (max)\n");
  504. X}
  505. Xif ( defined $uucp ) {
  506. X    $f = $uucp;
  507. X    $f = $` if $f =~ / /;
  508. X    print ("  uucp : \"$uucp\" ", &fstat($f,0,1), "\n");
  509. X    $f = $uuname;
  510. X    $f = $` if $f =~ / /;
  511. X    print ("         check host names using \"$uuname\" ", &fstat($f,0,1), "\n")
  512. X    if $uuname ne "";
  513. X    print ("         limits: ", $uucp_limits[1], "K (default), ",
  514. X       $uucp_limits[0], "K (min), ", $uucp_limits[2], "K (max)\n");
  515. X}
  516. Xprint ("\n");
  517. X
  518. Xprint ("Search strategies:");
  519. Xprint (" File") if $dofilesearch;
  520. Xprint (" Directory") if $dodirsearch;
  521. Xprint (" Index") if $doindexsearch;
  522. Xprint ("\n");
  523. Xprint ("\n");
  524. X
  525. Xif ( ! ($dofilesearch || $dodirsearch || $doindexsearch) ) {
  526. X    print ("*** No search strategy defined ***\n\n");
  527. X}
  528. X
  529. Xprint ("Archives:\n");
  530. Xforeach $lib ( @libdirs ) {
  531. X    print ("  ", $lib, " ", &fstat($lib,1,1), "\n");
  532. X}
  533. Xif ( defined $indexfile && defined $indexlib ) {
  534. X    print ("Archive for Index:\n");
  535. X    print ("  ", $indexlib, " ", &fstat($indexlib,1,1), "\n");
  536. X}
  537. Xprint ("\n");
  538. X
  539. Xif ( $doindexsearch && !( defined $indexfile ) ) {
  540. X    print ("*** No value for `indexfile' ***\n\n");
  541. X}
  542. X
  543. Xif ( $doindexsearch && defined $indexfile ) {
  544. X    print ("Indexfiles:\n");
  545. X    if ( $indexfile =~ m|^/| ) {
  546. X    print ("  ", $indexfile, " ", &fstat($indexfile), "\n");
  547. X    print ("  Archive for this index: ", $indexlib, "\n")
  548. X        if defined $indexlib;
  549. X    }
  550. X    else {
  551. X    foreach $lib ( @libdirs ) {
  552. X        local ($indexfile) = $lib . "/" . $indexfile;
  553. X        print ("  ", $indexfile, " ", &fstat($indexfile), "\n");
  554. X    }
  555. X    }
  556. X    print ("Limit per index request: ", $maxindexlines, " lines.\n")
  557. X    if $maxindexlines > 0;
  558. X    print ("\n");
  559. X    print ("Index tools:\n");
  560. X    print ("  gfind      ", $gfind, " ", &fstat($gfind,0,1), "\n");
  561. X    print ("  ixlookup   ", $ixlookup, " ", &fstat($ixlookup,0,1), "\n");
  562. X    print ("  locatelib  ", $locatelib, " ", &fstat($locatelib,1,1), "\n");
  563. X    print ("\n");
  564. X}
  565. X
  566. Xprint ("Server files:\n");
  567. Xprint ("  queue      ", $queue, " ", &fstat($queue), "\n");
  568. Xprint ("  logfile    ", $logfile, " ", &fstat($logfile), "\n");
  569. Xprint ("  lockfile   ", $lockfile, " ", &fstat($lockfile), "\n");
  570. Xprint ("  notes      ", $notesfile, " ", &fstat($notesfile), "\n");
  571. Xprint ("  hints      ", $hintsfile, " ", &fstat($hintsfile), "\n");
  572. Xprint ("\n");
  573. X
  574. X# Locking
  575. Xif ( defined $lock_fcntl ) {
  576. X    print ("Locking with fcntl(2).\n");
  577. X}
  578. Xif ( defined $lock_flock ) {
  579. X    print ("Locking with flock(2).\n");
  580. X}
  581. Xif ( defined $lock_lockf ) {
  582. X    print ("Locking with syscall(2)/lockf(2).\n");
  583. X}
  584. Xif ( defined $lock_fcntl + defined $lock_flock + defined $lock_lockf > 1 ) {
  585. X    print ("*** Select one lock method.\n");
  586. X}
  587. Xif ( defined $lock_fcntl + defined $lock_flock + defined $lock_lockf == 0 ) {
  588. X    print ("No locking selected. Proceed at your own risk\n");
  589. X}
  590. Xelse {
  591. X    # Just a quick test to see if things fit.
  592. X    local ($lf) = "/usr/tmp/fl$$";
  593. X    open (LF, ">$lf");
  594. X    eval { &locking (*LF, 0); };
  595. X    print "$@" if "$@";
  596. X    close (LF);
  597. X    unlink ($lf);
  598. X    print ("Use the 'testlock' program to verify the locking! (See INSTALL)\n");
  599. X}
  600. Xprint ("\n");
  601. X
  602. X%enctab = ("B", "btoa", "U", "uuencode", "X", "xxencode", "D", "uue");
  603. X
  604. Xprint ("Default encoding is ", $default_encoding, 
  605. X       " (", $enctab{$default_encoding}, ")\n");
  606. Xprint ("Encoders:\n");
  607. Xforeach $f ( "btoa", "uuencode", "uue", "xxencode" ) {
  608. X    $exec = eval("\$$f");
  609. X    printf ("  %-10s %s %s\n", $f, $exec, 
  610. X        &fstat($exec,0,
  611. X           $f eq "uuencode" || $f eq $enctab{$default_encoding}),
  612. X        "\n");
  613. X}
  614. X
  615. X# print ("Tools:\n");
  616. Xprint ("\n");
  617. X
  618. Xif ( defined $packing_limit ) {
  619. X    print ("Support for packing is included.\n",
  620. X       "  Packing limit = $packing_limit blocks.\n",
  621. X       "  Dusk usage obtained using \"$du\" ", &fstat($du,0,1), "\n",
  622. X       "  File list obtained using \"$find\" ", &fstat($find,0,1), "\n",
  623. X       "  Methods:");
  624. X    if ( defined $pdtar ) {
  625. X    print (" tar ", &fstat($pdtar,0,1));
  626. X    }
  627. X    else {
  628. X    print (" tar ", &fstat($tar,0,1));
  629. X    }
  630. X    print (" zip ", &fstat($zip,0,1));
  631. X    print (" zoo ", &fstat($zoo,0,1));
  632. X    print ("\n");
  633. X    if ( defined $pdtar ) {
  634. X    print ("  Compress/Tar using \"$pdtar\" ", &fstat($pdtar,0,1), "\n");
  635. X    }
  636. X    else {
  637. X    print ("  Compress/Tar using \"$tar\" ", &fstat($tar,0,1), " and ",
  638. X           "\"$compress\" ", &fstat($compress,0,1), "\n");
  639. X    }
  640. X    print ("\n");
  641. X}
  642. Xelse {
  643. X    print ("Packing functionality not selected.\n\n");
  644. X}
  645. Xprint ("Working storage: $tmpdir ", &fstat($tmpdir,1,1), "\n\n");
  646. Xprint ("The queue will ", $auto_runrequest ? "automatically" : "not",
  647. X       " be run upon completion of process.\n\n");
  648. X
  649. X################ Subroutines ################
  650. X
  651. Xsub fstat {
  652. X    local ($file, $dir, $mustexist) = @_;
  653. X    return "[*** Not found ***]" if ! -e $file && $mustexist;
  654. X    return "[Not found, but that's OK]" unless -e _;
  655. X    return "[*** Not a directory ***]" if $dir && ! -d _;
  656. X    "[OK]";
  657. X}
  658. X
  659. Xsub options {
  660. X    require "newgetopt.pl";
  661. X    $opt_ident = $opt_help = 0;
  662. X    if ( !&NGetOpt ("ident", "help")
  663. X    || $opt_help
  664. X    || (@ARGV > 0)) {
  665. X    &usage;
  666. X    }
  667. X}
  668. X
  669. Xsub usage {
  670. X    print STDERR <<EndOfUsage;
  671. X$my_package [$my_name $my_version]
  672. X
  673. XUsage: $my_name [-help] [-ident]
  674. X
  675. XOptions:
  676. X    -help    this message
  677. X    -ident    print identification
  678. XEndOfUsage
  679. X    exit (1);
  680. X}
  681. END_OF_FILE
  682.   if test 8630 -ne `wc -c <'chkconfig.pl'`; then
  683.     echo shar: \"'chkconfig.pl'\" unpacked with wrong size!
  684.   fi
  685.   # end of 'chkconfig.pl'
  686. fi
  687. if test -f 'dorequest.pl' -a "${1}" != "-c" ; then 
  688.   echo shar: Will not clobber existing file \"'dorequest.pl'\"
  689. else
  690.   echo shar: Extracting \"'dorequest.pl'\" \(8518 characters\)
  691.   sed "s/^X//" >'dorequest.pl' <<'END_OF_FILE'
  692. X#!/usr/local/bin/perl
  693. X# dorequest.pl -- 
  694. X# SCCS Status     : @(#)@ dorequest    3.17
  695. X# Author          : Johan Vromans
  696. X# Created On      : ***
  697. X# Last Modified By: Johan Vromans
  698. X# Last Modified On: Sat Jun  6 21:11:24 1992
  699. X# Update Count    : 135
  700. X# Status          : Going steady
  701. X
  702. X# Usage: dorequest [options] -- to run the queue
  703. X#
  704. X#     dorequest [options] address file [ encoding [ limit [ list ] ] ]
  705. X#        -- to send a file 'by hand'.
  706. X#
  707. X#   address : where to send the information to.
  708. X#          If left empty, no splitting is done, and the result
  709. X#          is written to stdout.
  710. X#
  711. X#   file    : the file to send.
  712. X#
  713. X#   encoding: how to encode it: U (uuencode), B (btoa), D (Dumas uue)
  714. X#          or A (plain).
  715. X#             Default is btoa.
  716. X#
  717. X#   limit   : how many bytes per transmission.
  718. X#             Default is 32768
  719. X#
  720. X#   parts   : comma-separated list of part numbers.
  721. X#             When used, only these parts are sent.
  722. X#
  723. X$my_name = "dorequest";
  724. X$my_version = "3.17";
  725. X#
  726. X################ Common stuff ################
  727. X
  728. X$libdir = $ENV{"MSERVLIB"} || "/usr/local/lib/mserv";
  729. Xunshift (@INC, $libdir);
  730. Xrequire "mserv_common.pl";
  731. X
  732. X################ Options handling ################
  733. X
  734. X&options if @ARGV > 0 && $ARGV[0] =~ /^-+[^-]+/;
  735. Xundef $mailer_delay if $opt_debug;
  736. X
  737. X################ Setting up ################
  738. X
  739. Xif ( @ARGV > 0 ) {
  740. X    &usage unless @ARGV > 1;
  741. X    local ($rcpt, $address, $request, $file, $encoding, $limit, $parts);
  742. X    ($rcpt, $file, $encoding, $limit, $parts) = @ARGV;
  743. X    $request = $file;
  744. X    $address = $rcpt;
  745. X    require "$libdir/dr_mail.pl";
  746. X    &mail_request ($rcpt, $address, $request, $file, $encoding, $limit, $parts);
  747. X}
  748. Xelse {
  749. X    &synchronize;
  750. X    &seize_queue;
  751. X    while ( @queue > 0 ) {
  752. X    local ($current_queue_entry) = &shift_queue;
  753. X    local (@arg) = split (/[ \t\n]/, $current_queue_entry);
  754. X    $current_queue_entry = join (" ", @arg);
  755. X    local ($cmd) = shift (@arg);
  756. X
  757. X    if ( $cmd eq "M" ) {
  758. X        require "$libdir/dr_mail.pl";
  759. X        eval { &mail_request (@arg); };
  760. X    }
  761. X    elsif ( $cmd eq "U" ) {
  762. X        require "$libdir/dr_uucp.pl";
  763. X        eval { &uucp_request (@arg); };
  764. X    }
  765. X    elsif ( $cmd eq "MP" ) {
  766. X        require "$libdir/dr_pack.pl";
  767. X        eval { &pack_mail_request (@arg); };
  768. X    }
  769. X    elsif ( $cmd eq "UP" ) {
  770. X        require "$libdir/dr_pack.pl";
  771. X        eval { &pack_uucp_request (@arg); };
  772. X    }
  773. X    else {
  774. X        # This is fatal!
  775. X        &die ("Illegal request in queue: $cmd @arg");
  776. X    }
  777. X    }
  778. X    # Get rid of queue backup file.
  779. X    unlink ("$queue~");
  780. X}
  781. X
  782. Xexit (0);
  783. X
  784. X################ Subroutines ################
  785. X
  786. Xsub synchronize {
  787. X
  788. X    # NOTE: It is very important to prevent multiple copies
  789. X    #        of this program to run at the same time!
  790. X
  791. X    # Proceed at your own risk here...
  792. X    return unless defined $lockfile;
  793. X
  794. X    # Create lockfile if it does not exists.
  795. X    if ( ! -e $lockfile ) {
  796. X    open (LF, ">$lockfile");
  797. X    close (LF);
  798. X    }
  799. X
  800. X    # Open it, and get exclusive access.
  801. X    open (LF, "+<$lockfile")
  802. X    || &die ("Cannot gain lock [$!]");
  803. X    local ($ret) = &locking (*LF, 0);
  804. X    # Exit gracefully if some other invocation has the lock.
  805. X    exit (0) if $ret == 0;
  806. X    &die ("Cannot lock lockfile [$!]") unless $ret == 1;
  807. X
  808. X    # We keep it locked until process termination.
  809. X}
  810. X
  811. Xsub seize_queue {
  812. X
  813. X    local ($queuecnt);
  814. X
  815. X    # First, check the queue backup. This file can exists only
  816. X    # if a previous run failed to terminate normally.
  817. X    if (open (QUEUE, "$queue~")) {
  818. X    @queue = <QUEUE>;    # Slurp.
  819. X    close (QUEUE);
  820. X    unlink ("$queue~")
  821. X        || &die ("Cannot unlink queue~ [$!]");
  822. X    $queuecnt = @queue;
  823. X    print STDERR ("Got $queuecnt entries from $queue~\n")
  824. X        if $opt_debug;
  825. X    }
  826. X    else {
  827. X    @queue = ();
  828. X    $queuecnt = 0;
  829. X    }
  830. X
  831. X    # Now check the current queue. We use exclusive access to make
  832. X    # sure no other process is updating it.
  833. X    # Again, proceed at your own risk if you're not using locks.
  834. X    if (open (QUEUE, "+<$queue" )) {
  835. X    # We cannot use rename queue -> queue~, since some other process
  836. X    # may already be waiting for the queue to become free.
  837. X    # Therefore slurp + truncate it.
  838. X    if ( &locking (*QUEUE, 1) ) {
  839. X        push (@queue, <QUEUE>); # Slurp.
  840. X        truncate ($queue, 0)
  841. X        || &die ("Cannot truncate queue [$!]");
  842. X        close (QUEUE);
  843. X    }
  844. X    else {
  845. X        &die ("Cannot seize queue [$!]");
  846. X    }
  847. X    print STDERR ("Got ",  @queue-$queuecnt, " entries from $queue\n")
  848. X        if $opt_debug;
  849. X    }
  850. X    # 'No queue' is a normal situation....
  851. X}
  852. X
  853. Xsub shift_queue {
  854. X    # Sync the memory copy of the queue to disk (in the queue backup
  855. X    # file), and extract the first entry of it.
  856. X
  857. X    open (QUEUE, ">$queue~")
  858. X    || &die ("Cannot sync queue [$!]");
  859. X    print QUEUE @queue;        # Blurb.
  860. X    close (QUEUE);
  861. X
  862. X    # Get entry from queue and return it.
  863. X    shift (@queue);
  864. X}
  865. X
  866. Xsub check_file {
  867. X    local ($file, $dir) = @_;
  868. X
  869. X    # Check if a given file still exists. Non-existent files are
  870. X    # trapped anyway, but this gives a better error message.
  871. X
  872. X    return 1 if -r $file && ( $dir ? ( -d _ && -x _ ) : -f _ );
  873. X    &die (($dir ? "Directory" : "File") . 
  874. X      " \"$file\" is no longer available");
  875. X}
  876. X
  877. X################ subroutines ################
  878. X
  879. Xsub fnsplit {
  880. X    local ($file) = @_;
  881. X    # Normalize $file -> ($dir, $basename)
  882. X    local (@path) = split (/\/+/, $file);
  883. X    (join ("/", @path[0..$#path-1]), $path[$#path]);
  884. X}
  885. X
  886. Xsub system {
  887. X    local ($cmd) = (@_);
  888. X    local ($ret);
  889. X    local ($opt_nolog) = 0;
  890. X    print STDERR ("+ $cmd\n") if $opt_trace;
  891. X    $ret = system ($cmd);
  892. X    &die (sprintf ("Return 0x%x from \"$cmd\"", $ret))
  893. X    unless $ret == 0;
  894. X    $ret;
  895. X}
  896. X
  897. Xsub symlink {
  898. X    local ($old, $new) = @_;
  899. X    print STDERR ("+ symlink $old $new\n") if $opt_trace;
  900. X    symlink ($old, $new)
  901. X    || &die ("Cannot symlink $old to $new [$!]\n");
  902. X}
  903. X
  904. Xsub die {
  905. X    local ($msg) = (@_);
  906. X    local ($opt_nolog) = 0;    # Will force logging
  907. X    local ($opt_debug) = 1;    # Will force msg to STDERR
  908. X    &writelog ("F $msg");
  909. X    if ( defined $current_queue_entry ) {
  910. X    &writelog ("Q $current_queue_entry");
  911. X    &feedback ($current_queue_entry, $msg);
  912. X    }
  913. X    die ("Aborted\n");
  914. X}
  915. X
  916. Xsub writelog {
  917. X
  918. X    # Write message to logfile, if possible, Otherwise use STDERR.
  919. X
  920. X    local (@tm) = localtime (time);
  921. X    local ($msg) = sprintf ("%02d%02d%02d %02d:%02d %s\n", 
  922. X                $tm[5], $tm[4]+1, $tm[3], $tm[2], $tm[1], $_[0]);
  923. X
  924. X    if ( !$opt_nolog && defined $logfile && ( -w $logfile ) && 
  925. X    open (LOG, ">>" . $logfile) ) {
  926. X    if ( &locking (*LOG, 1) ) {
  927. X        seek (LOG, 0, 2);
  928. X        print LOG $msg;
  929. X        close LOG;
  930. X        return unless $opt_debug;
  931. X    }
  932. X    }
  933. X
  934. X    print STDERR $msg;
  935. X}
  936. X
  937. Xsub feedback {
  938. X    local ($q, $msg) = @_;
  939. X
  940. X    # Try to send a message to the requestor indicating
  941. X    # something went wrong.
  942. X
  943. X    local ($type, $rcpt, @q) = split (/ /, $q);
  944. X    local ($file, $req, $method);
  945. X    if ( $type =~ /^U/ ) {
  946. X    ($req, $file) = @q[2,3];
  947. X    $method = "via UUCP to \"$q[0]\"";
  948. X    }
  949. X    else {
  950. X    ($req, $file) = @q[1,2];
  951. X    $method = "via email to \"$q[0]\"";
  952. X    }
  953. X
  954. X    local ($cmd) = "$sendmail '" . $rcpt . "'";
  955. X
  956. X    print STDERR ("+ |", $cmd, "\n") if $opt_trace;
  957. X
  958. X    return unless open (MAIL, "|" . $cmd);
  959. X    print MAIL <<EOD;
  960. XTo: $rcpt
  961. XSubject: Mail Server error
  962. XX-Server: $my_package [$my_name $my_version]
  963. XX-Oops: I am sorry for the inconvenience
  964. X
  965. XDear user,
  966. X
  967. XEOD
  968. X    $message = "A mail server error has occurred while trying to transfer ".
  969. X    "\"$file\" $method in response to your request for \"$req\".";
  970. X    select (MAIL); 
  971. X    $~ = "fill";
  972. X    write;
  973. X    print MAIL <<EOD;
  974. X
  975. XThe error message was:
  976. X   $msg
  977. X
  978. XYou may wish to resubmit your request, or consult the mail server 
  979. Xmaintainer. 
  980. X(He knows about the error already, no need to inform him.)
  981. X
  982. XEOD
  983. X    close (MAIL);
  984. X    select (STDOUT);
  985. X}
  986. X
  987. Xformat fill =
  988. X^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
  989. X$message
  990. X.
  991. X
  992. Xsub options {
  993. X    require "newgetopt.pl";
  994. X    if ( !&NGetOpt ("nomail", "keep=s",
  995. X            "debug", "trace", "help")
  996. X    || defined $opt_help ) {
  997. X    &usage;
  998. X    }
  999. X    $opt_trace |= $opt_debug;
  1000. X}
  1001. X
  1002. Xsub usage {
  1003. X    print STDERR <<EndOfUsage;
  1004. X$my_package [$my_name $my_version]
  1005. X
  1006. XUsage: $my_name [options] [address file [coding [size [parts]]]]
  1007. X
  1008. XOptions:
  1009. X    -nomail    do not deliver
  1010. X    -keep XXX    keep temporary files, using prefix XXX (for debugging)
  1011. X    -help    this message
  1012. X    -trace    show commands
  1013. X    -debug    for debugging
  1014. X
  1015. Xaddress        destination for this request.
  1016. X        If empty: do not split and write to STDOUT.
  1017. Xfile        the file to send.
  1018. Xcoding        encoding (Btoa, Uuencode, Dumas uue or Plain, def Btoa).
  1019. Xsize        max. size per chunk, def 32K.
  1020. Xparts        comma-separated list of parts to re-send.
  1021. X        If omitted: send all parts
  1022. XEndOfUsage
  1023. X    exit (!defined $opt_help);
  1024. X}
  1025. END_OF_FILE
  1026.   if test 8518 -ne `wc -c <'dorequest.pl'`; then
  1027.     echo shar: \"'dorequest.pl'\" unpacked with wrong size!
  1028.   fi
  1029.   # end of 'dorequest.pl'
  1030. fi
  1031. if test -f 'dr_mail.pl' -a "${1}" != "-c" ; then 
  1032.   echo shar: Will not clobber existing file \"'dr_mail.pl'\"
  1033. else
  1034.   echo shar: Extracting \"'dr_mail.pl'\" \(7155 characters\)
  1035.   sed "s/^X//" >'dr_mail.pl' <<'END_OF_FILE'
  1036. X# dr_mail.pl -- handle request via email
  1037. X# SCCS Status     : @(#)@ dr_mail.pl    3.1
  1038. X# Author          : Johan Vromans
  1039. X# Created On      : Thu Jun  4 22:22:20 1992
  1040. X# Last Modified By: Johan Vromans
  1041. X# Last Modified On: Thu Jun  4 23:06:48 1992
  1042. X# Update Count    : 8
  1043. X# Status          : OK
  1044. X
  1045. Xsub mail_request {
  1046. X
  1047. X    local ($rcpt, $address, $request, $file, $encoding, $limit, $parts) = @_;
  1048. X
  1049. X    if ( $opt_debug ) {
  1050. X    print STDERR ("&mail_request(rcpt=$rcpt, address=$address, ",
  1051. X              "request=$request,\n",
  1052. X              "    file=$file,\n",
  1053. X              "    encoding=$encoding, limit=$limit, parts=$parts)\n");
  1054. X    }
  1055. X
  1056. X    # This routine handles the requests.
  1057. X    # Handling includes encoding, splitting and transmitting.
  1058. X
  1059. X    &check_file ($file, 0);
  1060. X
  1061. X    local ($fname);        # Basename of file to send
  1062. X    local ($cmd);        # Command to handle encoding
  1063. X    local ($code);        # Verbose description of encoding
  1064. X    local ($files);        # Number of files to send
  1065. X    local (@files);        # List of files to send
  1066. X    local ($the_file);        # Current part be send
  1067. X    local ($the_part);        # Sequence number thereof
  1068. X    local ($size);        # Size of chunk
  1069. X    local ($tmpfile_prefix) = $opt_keep || "$tmpdir/drq$$.";
  1070. X    local ($Dtmpdir);        # Private dir for Dumas uue
  1071. X    local ($opt_nolog) = $opt_nolog;
  1072. X    local ($opt_keep) = $opt_keep;
  1073. X
  1074. X    if ( $address eq "" || $address eq "-" ) {
  1075. X    # Use this e.g. to include an encoded archive in email.
  1076. X    $limit = "0";
  1077. X    $opt_nolog = 1;        # Local.
  1078. X    $address = "";
  1079. X    }
  1080. X    $limit = 32*1024 if $limit eq "";
  1081. X    if ( $limit ne "0" ) {
  1082. X    # Limit must be between 10 and 256K, with 32K default.
  1083. X    $limit =  $`*1024 if $limit =~ /K$/;
  1084. X    $limit =  10*1024 if $limit <  10*1024;
  1085. X    $limit = 256*1024 if $limit > 256*1024;
  1086. X    }
  1087. X    print STDERR ("Using limit = $limit\n") if $opt_debug;
  1088. X
  1089. X    $encoding = $default_encoding unless defined $encoding;
  1090. X
  1091. X    # Get dir and basename of the requested file.
  1092. X    local ($dir, $fname) = &fnsplit ($file);
  1093. X
  1094. X    # Prepare the command to use.
  1095. X    # The result of command should be the encoded file, written
  1096. X    # to standard output.
  1097. X
  1098. X    if ( $encoding =~ /^u/i ) {
  1099. X
  1100. X    # Standard UU encoding.
  1101. X    $encoding = "U";
  1102. X    $code = "uuencoded";
  1103. X    $cmd = "$uuencode $file '$fname'";
  1104. X    }
  1105. X    elsif ( $encoding =~ /^x/i ) {
  1106. X
  1107. X    # Modified UU encoding.
  1108. X    $encoding = "X";
  1109. X    $code = "xxencoded";
  1110. X    $cmd = "$xxencode $file '$fname'";
  1111. X    }
  1112. X    elsif ( $encoding =~ /^d/i ) {
  1113. X
  1114. X    # Dumas' modified UU encoding.
  1115. X    # Uue has a built-in facility to generate multi-part
  1116. X    # files. The customer wants to use this feature...
  1117. X    local ($split) = '';
  1118. X    $encoding = "D";
  1119. X    $code = "uue-encoded";
  1120. X    $split = '-' . (int ($limit / 63) - 2) if $limit;
  1121. X
  1122. X    # Prepare a private directory for uue to work in.
  1123. X    $Dtmpdir = "$tmpdir/D$$";
  1124. X    &system ("rm -fr $Dtmpdir");
  1125. X    &system ("mkdir $Dtmpdir");
  1126. X    &symlink ($file, "$Dtmpdir/$fname");
  1127. X    $cmd = "cd $Dtmpdir; $uue $split '$fname'";
  1128. X    }
  1129. X    elsif ( $encoding =~ /^[pa]/i || $encoding eq "" ) {
  1130. X    
  1131. X    # No decoding.
  1132. X    $encoding = "A";
  1133. X    $code = "ascii";
  1134. X    $cmd = "";
  1135. X    }
  1136. X    else {
  1137. X
  1138. X    # Binary-to-Ascii encoding.
  1139. X    $encoding = "B";
  1140. X    $code = "btoa encoded";
  1141. X    $cmd = "$btoa < $file";
  1142. X    }
  1143. X    print STDERR ("Using encoding = $encoding ($code)\n") if $opt_debug;
  1144. X
  1145. X    if ( $encoding eq "A" && ($limit == 0 || (-s $file <= $limit)) ) {
  1146. X    # A simple ascii file smaller than $limit -> use it.
  1147. X    @files = ($file);
  1148. X    $opt_keep = 1;        # Local copy!
  1149. X    }
  1150. X    elsif ( $encoding eq "D" ) {
  1151. X    local ($path) = ($Dtmpdir);
  1152. X
  1153. X    # Encode and split.
  1154. X    &system ($cmd);
  1155. X
  1156. X    # Now gather all the parts, and tally them.
  1157. X    opendir (DIR, $path)
  1158. X        || &die ("Cannot read $path/ [$!]");
  1159. X    @files = sort (grep (/\.u[a-z][a-z]$/o, readdir (DIR)));
  1160. X    close (DIR);
  1161. X    foreach ( @files ) {
  1162. X        # Note: $_ is a *ref* into @files!
  1163. X        $_ = "$path/$_";
  1164. X    }
  1165. X    }
  1166. X    else {
  1167. X    # It is tempting to use 'split' to cut the request into
  1168. X    # pieces. Until recently, I did.
  1169. X    # Splitting ourselves makes it possible to split ascii files
  1170. X    # also. In this case we can spare another process.
  1171. X    local ($suffix) = "aa";
  1172. X    local ($size) = $limit + 1;
  1173. X
  1174. X    if ( $cmd ) {
  1175. X        print STDERR ("+ $cmd|\n") if $opt_trace;
  1176. X        open (FEED, "$cmd|")
  1177. X        || die ("Error opening pipe \"$cmd|\" [$!]\n");
  1178. X    }
  1179. X    else {
  1180. X        print STDERR ("+ <$file\n") if $opt_trace;
  1181. X        open (FEED, "$file")
  1182. X        || die ("Error opening file \"$file\" [$!]\n");
  1183. X    }
  1184. X
  1185. X    @files = ();
  1186. X    while ( <FEED> ) {
  1187. X        if ( $limit > 0 && ($size += length ($_)) > $limit ) {
  1188. X        close (OUT);
  1189. X        open (OUT, ">$tmpfile_prefix$suffix")
  1190. X            || die ("Cannot create $tmpfile_prefix$suffix: [$!]\n");
  1191. X        push (@files, "$tmpfile_prefix$suffix");
  1192. X        $size = length ($_);
  1193. X        $suffix++;
  1194. X        }
  1195. X        print OUT;
  1196. X    }
  1197. X    close (OUT);
  1198. X    close (FEED);
  1199. X    }
  1200. X
  1201. X    $files = @files;
  1202. X
  1203. X    if ( $opt_debug ) {
  1204. X    if ( $files > 1 ) {
  1205. X        print STDERR ("Sending ", $files, " files: ",
  1206. X              $files[0], " .. ", $files[$#files], "\n");
  1207. X    }
  1208. X    elsif ( $files == 1 ) {
  1209. X        print STDERR ("Sending file: ", $files[0], "\n");
  1210. X    }
  1211. X    else {
  1212. X        printf STDERR ("No files to send.\n");
  1213. X    }    
  1214. X    }
  1215. X
  1216. X    $the_part = 0;
  1217. X    foreach $the_file ( @files ) {
  1218. X
  1219. X    $the_part++;
  1220. X
  1221. X    if ( $parts && $parts !~ /\b$the_part\b/ ) {
  1222. X        unlink ($the_file) unless $opt_keep;
  1223. X        print STDERR ("Skipping part $the_part (not requested).\n")
  1224. X        if $opt_debug;
  1225. X        next;
  1226. X    }
  1227. X    else {
  1228. X        print STDERR ("Sending part $the_part of $files.\n")
  1229. X        if $opt_debug;
  1230. X    }
  1231. X
  1232. X    # Form "part xx of yy" message.
  1233. X    $part = ( $files == 1 ) ? "complete" : "part $the_part of $files";
  1234. X
  1235. X    # Send it.
  1236. X    if ( open (PART, $the_file) ) {
  1237. X        if ( $address eq "" ) {
  1238. X        $size = © (*STDOUT);
  1239. X        }
  1240. X        else {
  1241. X        # Suppress sleep after the last part.
  1242. X        local ($mailer_delay) = $mailer_delay;
  1243. X        undef $mailer_delay if $the_part == $files;
  1244. X        $size = &xfer;
  1245. X        }
  1246. X        close (PART);
  1247. X    }
  1248. X
  1249. X    # Write a log message.
  1250. X    &writelog ("M \"$address\" $request $encoding$the_part/$files $size")
  1251. X        if $address ne "";
  1252. X
  1253. X    unlink ($the_file) unless $opt_keep;
  1254. X    }
  1255. X
  1256. X    &system ("rm -fr $Dtmpdir") if $encoding eq "D" && !$opt_keep;
  1257. X}
  1258. X
  1259. Xsub headers {
  1260. X    local (*FILE, $full) = @_;
  1261. X
  1262. X    # Provide some RFC822 compliant headers.
  1263. X
  1264. X    local ($size) = 0;
  1265. X
  1266. X    if ( defined $sender ) {
  1267. X    print FILE "$sender\n";
  1268. X    $size += length ($sender) + 1;
  1269. X    }
  1270. X
  1271. X    $ln = "To: $address\n";
  1272. X    $ln .= "Subject: $fname ($part) $code\n";
  1273. X    $ln .= "Precedence: bulk\n";
  1274. X    $ln .= join ("\n", @x_headers) . "\n" if defined @x_headers;
  1275. X    print FILE ($ln, "\n");
  1276. X    $size += length ($ln) + 1;
  1277. X}
  1278. X
  1279. Xsub copy {
  1280. X    local (*FILE) = shift (@_);
  1281. X    local ($size);
  1282. X    local ($ln);
  1283. X
  1284. X    $ln = "Request: $request\n\n".
  1285. X    "------ begin of $fname -- $code -- $part ------\n";
  1286. X    $size = length ($ln);
  1287. X    print FILE $ln;
  1288. X    while ( <PART> ) {
  1289. X    print FILE $_;
  1290. X    $size += length ($_);
  1291. X    }
  1292. X    $ln = "------ end of $fname -- $code -- $part ------\n";
  1293. X    print FILE $ln;
  1294. X    $size + length ($ln);
  1295. X}
  1296. X
  1297. Xsub xfer {
  1298. X
  1299. X    # Send the file via e-mail.
  1300. X    local ($size);
  1301. X
  1302. X    if ( $opt_nomail ) {
  1303. X    print STDERR "[Would call \"$chunkmail\"]\n";
  1304. X    &headers (*STDOUT, 0);
  1305. X    }
  1306. X    elsif ( open (MAILER, "|$chunkmail '$address'") ) {
  1307. X    $size = &headers (*MAILER, 0);
  1308. X    $size += © (*MAILER);
  1309. X    close MAILER;
  1310. X
  1311. X    # Allow system to stabilize.
  1312. X    sleep ($mailer_delay) if defined $mailer_delay;
  1313. X    }
  1314. X    $size;
  1315. X}
  1316. X
  1317. X1;
  1318. END_OF_FILE
  1319.   if test 7155 -ne `wc -c <'dr_mail.pl'`; then
  1320.     echo shar: \"'dr_mail.pl'\" unpacked with wrong size!
  1321.   fi
  1322.   # end of 'dr_mail.pl'
  1323. fi
  1324. if test -f 'mserv_config.pl' -a "${1}" != "-c" ; then 
  1325.   echo shar: Will not clobber existing file \"'mserv_config.pl'\"
  1326. else
  1327.   echo shar: Extracting \"'mserv_config.pl'\" \(9253 characters\)
  1328.   sed "s/^X//" >'mserv_config.pl' <<'END_OF_FILE'
  1329. X# mserv_config.pl -- config info for mail server
  1330. X# Author          : Johan Vromans
  1331. X# Created On      : ***
  1332. X# Last Modified By: Johan Vromans
  1333. X# Last Modified On: Wed Jun 10 12:57:22 1992
  1334. X# Update Count    : 10
  1335. X# Status          : OK
  1336. X
  1337. X################ Preamble ################
  1338. X #
  1339. X # Owner of the mail server. Must be set.
  1340. X # This user need no special privileges, except for write access to the
  1341. X # mail server files, and read access to the archives.
  1342. X # It will get email about problem situations.
  1343. X$mserv_owner = "mserv";
  1344. X
  1345. X################ Reply section ################
  1346. X #
  1347. X # The mail server sends replies to the sender of messages.
  1348. X # It could use the current user id as its own address, but usually it
  1349. X # is better to substitute something else to prevent bounced mail
  1350. X # messages clobbering your system.
  1351. X #
  1352. X # Your domain. Unfortunately there is no reliable way of fetching this
  1353. X # from the system info.
  1354. X$domain = "mh.nl";
  1355. X #
  1356. X # Sender of the messages. Try to prevent annoying bounced messages.
  1357. X$mserv_sender = (getpwnam($mserv_owner))[6] || "Mail Server";
  1358. X$sender = "From: $mserv_sender <bit-bucket@$domain>";
  1359. X #
  1360. X # Mail server bcc id.
  1361. X # If set, this user gets a Bcc of each request. Can be used for
  1362. X # accounting, or to keep track of functionality.
  1363. X$mserv_bcc = $mserv_owner;
  1364. X #
  1365. X # Sendmail functionality. Will be called with the recipients on the
  1366. X # command line, and a pre-formatted message (including some headers) on 
  1367. X # standard input.
  1368. X # NOTE: Do not use `-t' if you're running smail3. It will exclude the
  1369. X #    named recipients from delivery.
  1370. X$sendmail = "/usr/lib/sendmail";
  1371. X #
  1372. X # Optional mail headers.
  1373. X # Undefine if not wanted.
  1374. X@x_headers = ("X-Server: $my_package [$my_name $my_version]",
  1375. X          "X-Info: Send mail to <postmaster@$domain>");
  1376. X
  1377. X################ Listener section ################
  1378. X #
  1379. X # When a mail message is received by the mail server, it is piped into
  1380. X # program 'listener'.
  1381. X # This program changes uid to the mail server owner, and executes
  1382. X # the 'process' program.
  1383. X #
  1384. X # Define $have_setruid if you have the setruid/setguid system calls.
  1385. X # In this case, the program needs to be installed setuid to the
  1386. X # mail server owner. If you do not define $have_setruid, the program has to
  1387. X # be installed setuid 'root'.
  1388. X$have_setruid = 1;
  1389. X #
  1390. X # Define $have_setenv if you have the setenv(3) library call. Using
  1391. X # setenv is optional.
  1392. X$have_setenv = 1;
  1393. X #
  1394. X # If you $have_setruid, you may define $use_uid also.
  1395. X # In this case the getpw* routines will not be used and
  1396. X # your executable will be significantly smaller and faster.
  1397. X$use_uid = 1;
  1398. X
  1399. X################ Email section ################
  1400. X #
  1401. X # The default strategy for the mail server is to transfer requests via
  1402. X # email. 
  1403. X #
  1404. X # Sendmail functionality. Will be called with the recipients on the
  1405. X # command line, and a pre-formatted message (including some headers) on 
  1406. X # standard input.
  1407. X # NOTE: Do not use `-t' if you're running smail3. It will exclude the
  1408. X #    named recipients from delivery.
  1409. X # Used by "dorequest" to transmit chunks of data via email.
  1410. X$chunkmail = "/usr/lib/sendmail -odq";
  1411. X #
  1412. X # The minimum,default,maximum size of email chunks in K.
  1413. X@email_limits = (10,64,1024);
  1414. X #
  1415. X # To prevent overloading the system by firing too many sendmails,
  1416. X # use this amount to sleep between sending chunks.
  1417. X$mailer_delay = 30;
  1418. X
  1419. X################ UUCP section ################
  1420. X #
  1421. X # The mail server can transfer requests via uucp to systems that are
  1422. X # connected that way. This is very efficient compared to email, e.g. 
  1423. X # no encoding overhead.
  1424. X #
  1425. X # Define '$uucp' if you want to use the uucp feature.
  1426. X # Append uucp grade, if desired (and your uucp supports it).
  1427. X$uucp = "/usr/bin/uucp -ga";
  1428. X #
  1429. X # Uucp host names can be checked for validity, if desired.
  1430. X # This is how to get a list of uucp host names. 
  1431. X # Set it to empty if you do not want to check the host names.
  1432. X$uuname = "/usr/bin/uuname";    # Check host names.
  1433. X #$uuname = "";            # Do not check host names.
  1434. X #
  1435. X # The minimum,default,maximum size of uucp chunks in K.
  1436. X@uucp_limits = (10,256,2048);
  1437. X
  1438. X################ Archives section ################
  1439. X #
  1440. X # Where to find the archive entries.
  1441. X@libdirs = ("/usr/local/src", "/beethoven/arch", "/users/jv/PD");
  1442. X # Please add mail server 'pub'!
  1443. Xpush (@libdirs, "$libdir/pub");
  1444. X #
  1445. X # Extensions we recognize. See "$dofilesearch" below.
  1446. X@exts = (".TZ", ".tar.Z", ".tar", ".shar.Z", ".shar", ".Z",
  1447. X     ".zoo", ".zip", ".arc", ".sit");
  1448. X
  1449. X################ Search strategies ################
  1450. X #
  1451. X # $dofilesearch: 
  1452. X #   Look for file: XXX must exist as file XXX in some lib dir.
  1453. X #   Known extensions are also tried.
  1454. X #   This is default if no other strategies are selected.
  1455. X #
  1456. X # $doindexsearch:
  1457. X #   Lookup XXXNNNYYY in $indexfile. 
  1458. X #   If $indexfile is a relative filename, every lib dir is supposed to
  1459. X #   have one. 
  1460. X #   If $indexfile is an absolute filename, the location it appears in
  1461. X #   will be considered part of the archives. This can be overridden with
  1462. X #   $indexlib.
  1463. X #
  1464. X # $dodirsearch:
  1465. X #   Look in dir: XXX or XXXNNNYYY (where NNN is a version indicator,
  1466. X #   e.g. '-1.02' and YYY a known extension, e.g. '.tar.Z') must exist
  1467. X #   in some lib dir, or subdir XXXNNN.
  1468. X #   Example: 'gcc' matches 'gcc', 'gcc.tar.Z', 'gcc-2.1.tar.Z',
  1469. X #            'gcc-2.1/gcc.tar.Z' etc.
  1470. X #
  1471. X # If your index matches the archives (as specified in @libdirs), you
  1472. X # can safely set $dodirsearch to 0.
  1473. X #
  1474. X$indexfile = "ix.codes";    # index file per archive directory
  1475. X#$indexfile = "$libdir/ix.codes";    # separate index file 
  1476. X#$indexlib  = $libdirs[0];        # archive for index file
  1477. X$dofilesearch = 1;
  1478. X$doindexsearch = defined $indexfile;
  1479. X$dodirsearch = 1;
  1480. X #
  1481. X # If doindexsearch is selected, index searches can return a huge amount
  1482. X # of information. Therefore enforce a limit on the max. number of lines
  1483. X # an index request can return. Zero means: no limit.
  1484. X$maxindexlines = 200;
  1485. X
  1486. X################ The mail server files ################
  1487. X #
  1488. X # No need to change these, I suppose.
  1489. X #
  1490. X # Where to store requests.
  1491. X$queue = $libdir . "/queue";
  1492. X # Where to log. Undefine if you do not want logging.
  1493. X # Note -- you can override this at run-time with 'doreqest -nolog'.
  1494. X #         'chmod -w $logfile' also works.
  1495. X$logfile = $libdir . "/logfile";
  1496. X # Lock file to guard against multiple executions of 'dorequest'.
  1497. X$lockfile = $libdir . "/lockfile";
  1498. X # notes file. Will be prepended to each confirmation message.
  1499. X # NOTE: if you change this, you'll need to change the Makefile also.
  1500. X$notesfile = $libdir . "/mserv.notes";
  1501. X # hints file. Will be appended to each confirmation message.
  1502. X # NOTE: if you change this, you'll need to change the Makefile also.
  1503. X$hintsfile = $libdir . "/mserv.hints";
  1504. X
  1505. X################ Locking section ################
  1506. X #
  1507. X # Select a locking method. Not selecting a locking method
  1508. X # voids your warranty.
  1509. X #
  1510. X # fcntl(2) locking. Requires "errno.ph" and "fcntl.ph".
  1511. X$lock_fcntl = 1;
  1512. X #
  1513. X # BSD style flock(2). Requires "errno.ph" and "sys/file.h".
  1514. X#$lock_flock = 1;
  1515. X #
  1516. X # lockf(2) locking. Requires "errno.ph", "unistd.ph" and "sys/syscall.ph".
  1517. X#$lock_lockf = 1;
  1518. X
  1519. X################ Encoding programs ################
  1520. X #
  1521. X # Default encoding. Select one of B, U, D, X and make sure the
  1522. X # corresponding encoding tool exists.
  1523. X$default_encoding = "B";    # btoa
  1524. X #
  1525. X # Encoding programs. Supply a full pathname.
  1526. X # Encoding commands will be disallowed if the corresponding
  1527. X # encoding program is not available.
  1528. X # Since uuencode is fixed, it should better be there!
  1529. X$btoa     = "/usr/local/bin/btoa";    # btoa/atob
  1530. X$uuencode = "/usr/bin/uuencode";    # uu{en.de}code
  1531. X$uue      = "/usr/local/bin/uue";     # Dumas uue/uud program
  1532. X$xxencode = "/usr/local/bin/xxencode";     # xx{en.de}code
  1533. X
  1534. X################ Index section ################
  1535. X #
  1536. X # The following are only needed if you select indexsearch.
  1537. X # `makeindex' uses the GNU find program and locate tools.
  1538. X # The actual index lookup is performed by GNU locate 3.6 (or later)
  1539. X # or a customized version of GNU locate 3.5. In the latter case,
  1540. X # you need to "make ixlookup" and "make install-ixlookup".
  1541. X$gfind = "/usr/local/bin/gfind";
  1542. X # The GNU locate library (used to find bigram and code).
  1543. X$locatelib = "/usr/local/lib/locate";
  1544. X#$ixlookup = $libdir . "/ixlookup";    # based on GNU locate 3.5
  1545. X$ixlookup = "/usr/local/bin/locate";    # as of GNU locate 3.6
  1546. X
  1547. X################ Packing section ################
  1548. X #
  1549. X # The following are only needed if you want to support the packing 
  1550. X # of directories.
  1551. X #
  1552. X # Max number of blocks in a directory (as returned by 'du -s').
  1553. X # Undefine (or set to zero) if you do not want to support packing.
  1554. X$packing_limit = 4100;
  1555. X #
  1556. X # Tools.
  1557. X$du       = "/bin/du";            # get size of dir
  1558. X$find     = "/usr/local/bin/gfind";    # find
  1559. X$pdtar    = "/usr/local/bin/pdtar";    # create compressed ustar
  1560. X$tar      = "/bin/tar";            # if no $pdtar...
  1561. X$compress = "/usr/ucb/compress";    # if no $pdtar...
  1562. X$zoo      = "/usr/local/bin/zoo";    # zoo
  1563. X$zip      = "/usr/local/bin/zip";    # zip
  1564. X
  1565. X################ Miscellaneous ################
  1566. X #
  1567. X # Working directory. Should have space for at least 1.5 times the
  1568. X # biggest file in the archives...
  1569. X #
  1570. X$tmpdir = $ENV{"TMPDIR"} || "/usr/tmp";
  1571. X
  1572. X # Should "dorequest" be run automatically after completion of
  1573. X # "process"?
  1574. X$auto_runrequest = 1;
  1575. X
  1576. X################ End of configuation info ################
  1577. X
  1578. X1;
  1579. END_OF_FILE
  1580.   if test 9253 -ne `wc -c <'mserv_config.pl'`; then
  1581.     echo shar: \"'mserv_config.pl'\" unpacked with wrong size!
  1582.   fi
  1583.   # end of 'mserv_config.pl'
  1584. fi
  1585. if test -f 'unpack.pl' -a "${1}" != "-c" ; then 
  1586.   echo shar: Will not clobber existing file \"'unpack.pl'\"
  1587. else
  1588.   echo shar: Extracting \"'unpack.pl'\" \(4170 characters\)
  1589.   sed "s/^X//" >'unpack.pl' <<'END_OF_FILE'
  1590. X#!/usr/local/bin/perl
  1591. X# unpack.pl -- unpack files
  1592. X# SCCS Status     : @(#)@ unpack    2.4
  1593. X# Author          : Johan Vromans
  1594. X# Created On      : Oct  2 21:33:00 1989
  1595. X# Last Modified By: Johan Vromans
  1596. X# Last Modified On: Sun May  3 17:37:22 1992
  1597. X# Update Count    : 5
  1598. X# Status          : Going steady
  1599. X
  1600. X# Unpack a set of files sent by the mail server with a tiny bit
  1601. X# of error detection.
  1602. X#
  1603. X# Usage: save all the parts in one big file (in the correct order), 
  1604. X# say "foo", and then execute:
  1605. X#
  1606. X#   perl unpack.pl foo
  1607. X#
  1608. X# Note: if the filename contains a path, all subdirectories should 
  1609. X# exist!
  1610. X# Multiple files in one input stream are allowed: e.g:
  1611. X#
  1612. X#------ begin of INDEX -- ascii -- complete ------
  1613. X#------ end of INDEX -- ascii -- complete ------
  1614. X#------ begin of zoo.TZ -- btoa encoded -- part 1 of 2 ------
  1615. X#------ end of zoo.TZ -- btoa encoded -- part 1 of 2 ------
  1616. X#------ begin of zoo.TZ -- btoa encoded -- part 2 of 2 ------
  1617. X#------ end of zoo.TZ -- btoa encoded -- part 2 of 2 ------
  1618. X#
  1619. X#
  1620. X################ configuration section ################
  1621. X#
  1622. X# Where to find these...
  1623. X#
  1624. X$atob = "atob";            # Ascii -> Binary
  1625. X$uudecode = "uudecode";        # UU
  1626. X$xxdecode = "xxdecode";        # XX
  1627. X$uud = "uud";            # Dumas' uue/uud programs.
  1628. X#
  1629. X################ end of configuration section ################
  1630. X
  1631. X&init;
  1632. X
  1633. Xwhile ( $line = <> ) {
  1634. X
  1635. X    if ( $line =~ /^------ begin of (.+) -- (.+) -- (.+) ------/ ) {
  1636. X    print STDERR $line;
  1637. X
  1638. X    # If a filename is known, it must be the same.
  1639. X    if ( $file ) {
  1640. X        if ( $file != $1 ) {
  1641. X        &errmsg ("Filename mismatch");
  1642. X        }
  1643. X    }
  1644. X    else {
  1645. X        $file = $1;
  1646. X    }
  1647. X
  1648. X    # If an encoding is known, it must be the same.
  1649. X    if ( $encoding ) {
  1650. X        if ( $encoding != $2 ) {
  1651. X        &errmsg ("Encoding mismatch");
  1652. X        }
  1653. X    }
  1654. X    else {
  1655. X        # Determine encoding and build command.
  1656. X        $encoding = $2;
  1657. X        if ( $encoding eq "uuencoded" ) {
  1658. X        $cmd = "|$uudecode";
  1659. X        }
  1660. X        elsif ( $encoding eq "xxencoded" ) {
  1661. X        $cmd = "|$xxdecode";
  1662. X        }
  1663. X        elsif ( $encoding eq "btoa encoded" ) {
  1664. X        $cmd = "|$atob > $file";
  1665. X        }
  1666. X        elsif ( $encoding eq "uue-encoded" ) {
  1667. X        $cmd = "|$uud - ";
  1668. X        }
  1669. X        else {
  1670. X        $cmd = ">$file";
  1671. X        }
  1672. X    }
  1673. X
  1674. X    # If a 'parts' section is known, it must match.
  1675. X    # A bit more complex ...
  1676. X    $tparts = $3;
  1677. X    if ( $parts ) {
  1678. X        if ( $tparts =~ /part (\d+) of (\d+)/ ) {
  1679. X
  1680. X        $thispart++;    # Increment part number and check.
  1681. X        if ( $thispart != $1 ) {
  1682. X            &errmsg ("Sequence mismatch");
  1683. X        }
  1684. X
  1685. X        # Total number must match also.
  1686. X        if ( $numparts ) {
  1687. X            if ( $numparts != $2 ) {
  1688. X            &errmsg ("Numparts mismatch");
  1689. X            }
  1690. X        }
  1691. X        else {
  1692. X            $numparts = $2;
  1693. X        }
  1694. X        }
  1695. X        elsif ( $parts ne $tparts ) {
  1696. X        &errmsg ("Parts mismatch");
  1697. X        }
  1698. X    }
  1699. X    else {
  1700. X
  1701. X        # No 'parts' known yet.
  1702. X        $parts = $tparts;
  1703. X        if ( $tparts =~ /part (\d+) of (\d+)/ ) {
  1704. X        $thispart = $1;
  1705. X        # Should be first part.
  1706. X        if ( $thispart != 1 ) {
  1707. X            &errmsg ("Sequence mismatch");
  1708. X        }
  1709. X        $numparts = $2;
  1710. X        }
  1711. X        else {
  1712. X        $numparts = $thispart = 1;
  1713. X        }
  1714. X    }
  1715. X
  1716. X    # If we have a file open, enable copying.
  1717. X    if ( $fileok ) {
  1718. X        $copy = 1;
  1719. X    }
  1720. X    elsif ( open (OUTFILE, $cmd) ) {
  1721. X        $fileok = 1;
  1722. X        $copy = 1;
  1723. X    }
  1724. X    else {
  1725. X        &errmsg ("Cannot create $cmd");
  1726. X    }
  1727. X
  1728. X    # Matching end header to look for.
  1729. X    $trailer = "------ end " . substr ($line, 13, length($line)-13);
  1730. X
  1731. X    }
  1732. X    elsif ( $line =~ /^------ end of (.+) -- (.+) -- (.+) ------/ ) {
  1733. X
  1734. X    print STDERR $line;
  1735. X
  1736. X    # Check that the header matches.
  1737. X    if ( $line ne $trailer ) {
  1738. X        &errmsg ("Header/trailer mismatch");
  1739. X    }
  1740. X
  1741. X    # Wrap up if this was the last part.
  1742. X    &wrapup if $thispart == $numparts;
  1743. X
  1744. X    # Stop copying.
  1745. X    $copy = 0;
  1746. X    }
  1747. X    else {
  1748. X    if ( $copy ) {
  1749. X        print OUTFILE $line;
  1750. X    }
  1751. X    }
  1752. X}
  1753. X
  1754. Xif ( $numparts && ( $thispart != $numparts )) {
  1755. X    &errmsg ("Only $thispart of $numparts parts found");
  1756. X}
  1757. X
  1758. Xif ( $fileok) {
  1759. X    &errmsg ("Unterminated section") if $?;
  1760. X}
  1761. X
  1762. X################ Subroutines ################
  1763. X
  1764. Xsub init {
  1765. X    $encoding = "";
  1766. X    $parts = "";
  1767. X    $numparts = "";
  1768. X    $file = "";
  1769. X    $copy = 0;
  1770. X    $thispart = 0;
  1771. X    $fileok = "";
  1772. X}
  1773. X
  1774. Xsub wrapup {
  1775. X    close (OUTFILE);
  1776. X    &errmsg ("Output close error [$?]") if $?;
  1777. X    &init;
  1778. X}
  1779. X
  1780. Xsub errmsg {
  1781. X    print STDERR ($my_name, ": ", pop(@_), " at input line $..\n");
  1782. X    exit 1;
  1783. X}
  1784. END_OF_FILE
  1785.   if test 4170 -ne `wc -c <'unpack.pl'`; then
  1786.     echo shar: \"'unpack.pl'\" unpacked with wrong size!
  1787.   fi
  1788.   # end of 'unpack.pl'
  1789. fi
  1790. echo shar: End of archive 2 \(of 4\).
  1791. cp /dev/null ark2isdone
  1792. MISSING=""
  1793. for I in 1 2 3 4 ; do
  1794.     if test ! -f ark${I}isdone ; then
  1795.     MISSING="${MISSING} ${I}"
  1796.     fi
  1797. done
  1798. if test "${MISSING}" = "" ; then
  1799.     echo You have unpacked all 4 archives.
  1800.     rm -f ark[1-9]isdone
  1801. else
  1802.     echo You still must unpack the following archives:
  1803.     echo "        " ${MISSING}
  1804. fi
  1805. exit 0
  1806. exit 0 # Just in case...
  1807.